home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 9
/
FM Towns Free Software Collection 9.iso
/
t_os
/
tool
/
grid
/
grid.bas
next >
Wrap
BASIC Source File
|
1994-11-16
|
6KB
|
229 lines
1000 'グリッドロケーター
1010 ' 1994/07/07 by 尋燐・ルナ
1020 :
1030 CLS
1040 DEFSTR A :DEFDBL D,Z
1050 SCREEN 1,0,1,1 :SCREEN@ 0 :WIDTH 80,25
1060 :
1070 GOSUB *画面
1080 GOSUB *初期設定
1090 GOSUB *東経
1100 GOSUB *北緯
1110 GOSUB *入力
1120 IF F=0 THEN 1170
1130 GOSUB *計算
1140 GOSUB *結果
1150 GOTO 1110
1160 :
1170 END
1180 :
1190 *初期設定
1200 RESTORE 1200
1210 DIM AX(7,2) :'数字入力
1220 FOR I0=0 TO 2
1230 FOR I=1 TO 7
1240 READ AX(I,I0)
1250 NEXT :NEXT
1260 DATA 0,3,6,3,9,4,1, 1,3,8,1,2,2,9, P,M,9,6,C,P," "
1270 GOSUB *結果
1280 RETURN
1290 :
1300 *計算
1310 T1=VAL(AX(1,1)+AX(2,1)+AX(3,1)) :T2=VAL(AX(4,1)+AX(5,1)) :T3=VAL(AX(6,1)+AX(7,1))
1320 H1=VAL(AX(2,0)+AX(3,0)) :H2=VAL(AX(4,0)+AX(5,0)) :H3=VAL(AX(6,0)+AX(7,0))
1330 :
1340 Z1=((T1+T2/60+T3/3600)+180)/20
1350 Z2=((H1+H2/60+H3/3600)+90)/10
1360 :
1370 D1=FIX(Z1)
1380 D2=FIX((Z1-D1)*10)
1390 D3=(Z1*10-FIX(Z1*10))*10
1400 :
1410 D4=FIX(Z2)
1420 D5=FIX((Z2-D4)*10)
1430 D6=(Z2*10-FIX(Z2*10))*10
1440 :
1450 D7=FIX(D3*2.4!)
1460 D8=FIX(D6*2.4!)
1470 :
1480 AX(1,2)=CHR$(D1+&H41) :AX(2,2)=CHR$(D4+&H41)
1490 AX(3,2)=CHR$(D2+&H30) :AX(4,2)=CHR$(D5+&H30)
1500 AX(5,2)=CHR$(D7+&H41) :AX(6,2)=CHR$(D8+&H41)
1510 :
1520 IF F=1 THEN RETURN
1530 'test用表示
1540 SCREEN 0:
1550 PRINT T1,T2,T3
1560 PRINT H1,H2,H3
1570 PRINT "Z1=";Z1
1580 PRINT "Z2=";Z2
1590 PRINT "D1=";D1
1600 PRINT "D2=";D2
1610 PRINT "D3=";D3
1620 PRINT "D4=";D4
1630 PRINT "D5=";D5
1640 PRINT "D6=";D6
1650 PRINT "D7=";D7
1660 PRINT "D8=";D8
1670 A=INPUT$(1)
1680 SCREEN 1,0,1
1690 RETURN
1700 :
1710 *画面
1720 CLS
1730 LINE (0,0)-(639,479),PSET,%5,BF,&H4040404004040404
1740 CONNECT (1,479)-(1,1)-(639,1),%5
1750 SYMBOL (10,10),"アマチュア無線",1,1,5,,,5
1760 SYMBOL (10,33),"グリッドロケーター の計算",2,1,6,,,5,2
1770 SYMBOL (500,35),"by 尋燐・ルナ",1,1,5,,,7
1780 SYMBOL (460,10),"Vol 1.1 1994/07/07",1,1,4,,,5
1790 LINE (0,60)-(639,61),PRESET,,B
1800 LINE (1,62)-(639,63),PSET,%5,B
1810 LINE (0,320)-(639,321),PRESET,,B
1820 LINE (1,322)-(639,323),PSET,%5,B
1830 RESTORE 1830
1840 GOSUB *BOX :GOSUB *BOX
1850 SYMBOL (250,220),"調べたい場所の東経・北緯を入力してください。",1,1,7
1860 SYMBOL (220,265),"使用キー",1,1,5,,,1
1870 SYMBOL (316,255),"計算 = 実行 移動 = カーソル",1,1,4
1880 SYMBOL (316,275),"終了 = ESC 入力 = 0 - 9",1,1,4
1890 SYMBOL (350,90),"o",1,1,7,,,5 :SYMBOL (480,95),"’",1,1,7,,,5
1900 SYMBOL (610,95),"’",1,1,7,,,5 :SYMBOL (617,95),"’",1,1,7,,,5
1910 SYMBOL (350,150),"o",1,1,7,,,5 :SYMBOL (480,155),"’",1,1,7,,,5
1920 SYMBOL (610,155),"’",1,1,7,,,5 :SYMBOL (617,155),"’",1,1,7,,,5
1930 RETURN
1940 DATA 210,285,290,285,0, 290,285,290,260,0, 210,285,210,260,5, 210,260,290,260,5
1950 DATA 200,300,580,300,5, 580,300,580,245,5, 200,300,200,245,0, 200,245,580,245,0
1960 :
1970 *東経
1980 A="東 経" :P=1
1990 GOSUB *表示
2000 RETURN
2010 :
2020 *北緯
2030 A="北 緯" :P=0
2040 GOSUB *表示
2050 RETURN
2060 :
2070 *表示
2080 IF P THEN Y=100 ELSE Y=160
2090 SYMBOL (70,Y),A,2,2,7,,,5
2100 GOSUB *ALL_P
2110 RETURN
2120 :
2130 *入力
2140 P=1 :L=1 :F=0
2150 GOSUB *反転
2160 A=INPUT$(1)
2170 IF A=CHR$(13) THEN F=1 :GOTO *E_入力
2180 IF A=CHR$(27) THEN F=0 :GOTO *E_入力
2190 IF A="T" OR A="t" THEN F=2 :GOTO *E_入力
2200 IF A="C" THEN CLS 4 :GOTO 2160
2210 IF A="F" OR A="f" THEN GOSUB *友 :GOTO 2160
2220 IF A=CHR$(28) THEN I=1 :GOTO *カーソル
2230 IF A=CHR$(29) THEN I=-1 :GOTO *カーソル
2240 IF A=CHR$(30) THEN I=0 :GOTO *カーソル
2250 IF A=CHR$(31) THEN I=0 :GOTO *カーソル
2260 IF A<"0" OR A>"9" THEN BEEP :GOTO 2160 ELSE I=VAL(A)
2270 'チェック
2280 IF L=4 OR L=6 THEN IF I>5 THEN BEEP :GOTO 2160
2290 IF L=1 AND I>1 THEN BEEP :GOTO 2160
2300 :
2310 AX(L,P)=A
2320 GOSUB *A_表示
2330 I=1
2340 GOTO 2420
2350 :
2360 *E_入力
2370 GOSUB *反転
2380 RETURN
2390 :
2400 *カーソル
2410 GOSUB *反転
2420 IF I=0 THEN P=-(P=0) ELSE L=L+I
2430 IF L<1 THEN P=-(P=0) :L=7
2440 IF L>7 THEN P=-(P=0) :L=1
2450 IF I>-1 AND L=1 AND P=0 THEN L=2
2460 IF I=-1 AND L=1 AND P=0 THEN L=7 :P=1
2470 GOTO 2150
2480 :
2490 *反転
2500 X=150+L*50 :Y=100-(P=0)*60
2510 X=X-(L>3)*30-(L>5)*30
2520 LINE (X,Y-3)-(X+41,Y+38),XOR,%5,B
2530 LINE (X+1,Y-2)-(X+40,Y+37),XOR,%5,B
2540 RETURN
2550 :
2560 *ALL_P
2570 X=150
2580 FOR I=1 TO 7
2590 X=X+50
2600 IF I=4 OR I=6 THEN X=X+30
2610 IF I=1 AND P=0 THEN 2630
2620 L=I :GOSUB *A_表示
2630 NEXT
2640 RETURN
2650 :
2660 *A_表示
2670 RESTORE 2670
2680 LINE (X,Y-3)-(X+40,Y+37),PSET,0,BF,&H4040404004040404
2690 GOSUB *BOX
2700 SYMBOL (X+6,Y+2),AKCNV$(AX(L,P)),2,2,5,,,1
2710 RETURN
2720 DATA 40,-3,40,37,0 ,0,37,40,37,0 ,0,-3,40,-3,5 ,0,-3,0,37,5
2730 :
2740 *BOX
2750 FOR I0=1 TO 4
2760 READ I1,I2,I3,I4,I5
2770 LINE (X+I1,Y+I2)-(X+I3,Y+I4),PSET,%I5,B
2780 LINE (X+I1+1,Y+I2+1)-(X+I3+1,Y+I4+1),PSET,%I5,B
2790 NEXT
2800 RETURN
2810 :
2820 *結果
2830 SYMBOL (30,335),"お調べのグリッドロケーターは、",1,1,6,,,3,3
2840 SYMBOL (500,435),"となりました。",1,1,6,,,3,3
2850 X=0 :Y=360 :P=2
2860 FOR I=1 TO 6
2870 X=X+80
2880 L=I :GOSUB *AN_表示
2890 NEXT
2900 :
2910 *AN_表示
2920 RESTORE 2920
2930 LINE (X,Y)-(X+60,Y+60),PSET,0,BF,&H4040404004040404
2940 GOSUB *BOX
2950 SYMBOL (X+7,Y+8),AKCNV$(AX(L,P)),3,3,5,,,1
2960 RETURN
2970 DATA 60,0,60,60,0 ,0,60,60,60,0 ,0,0,60,0,5 ,0,0,0,60,5
2980 :
2990 *友
3000 SCREEN 1,1,3
3010 LINE (200,130)-(450,400),PSET,%7,BF
3020 LINE (200,130)-(450,400),PSET,7,B
3030 RESTORE 3030 :X=210 :Y=140
3040 READ A
3050 IF A="END" THEN 3090
3060 SYMBOL (X,Y),A,1,1,6,,,1
3070 Y=Y+20
3080 GOTO 3040
3090 :A=INPUT$(1)
3100 SCREEN 1,0,1
3110 RETURN
3120 DATA "製作者 :JG0QKR"
3130 DATA "協力者 :JG0QKS"
3140 DATA "フレンド局:JG0BVZ"
3150 DATA " JG0PMU"
3160 DATA " JG0TDV"
3170 DATA " JG0XBI"
3180 DATA " JI0FLS"
3190 DATA "その他 :のりP"
3200 DATA " まーすけ"
3210 DATA " ゴルゴ小林"
3220 DATA "長野市に遊びに来られましたら"
3230 DATA " 430Mにてお声掛けください。"
3240 DATA " 尋燐・ルナ"
3250 DATA "END"
3260 :
3270 '----------- E N D ------------------